home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / button.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-12-15  |  7.9 KB  |  271 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Button"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Option Explicit
  13. Private rFont As StdFont
  14. Private rEnabled As Boolean
  15. Private IClicked As Boolean 'Informs the mouse events _
  16. that the MouseDown procedure was called by this button
  17. 'Private Declarations
  18. Private LastState As String 'Stores the Last Drawn _
  19. State of the button. Makes Drawing faster because, _
  20. If it has been down before why draw it down again?
  21. Private rHasFocus As Boolean
  22. Private rCaption As String 'Memory version of the Caption.
  23.  
  24. 'Public Declarations
  25. Public PressKey As en_ButtonKeys
  26. Public ImageIndex As Long
  27. Public BackColor As OLE_COLOR 'BackColor Property
  28. Public ForeColor As OLE_COLOR
  29. Public Left As Single 'Left Property
  30. Public Height As Single 'Height Property
  31. Public Parent As Object 'Parent of the 'Button'
  32. Public Picture As StdPicture
  33. Public Top As Single 'Top Property
  34. Public Width As Single 'Width Property
  35. Public Name As String 'Basic ID
  36. Public ButtonParentObj As ComboPack.ButtonMngr 'If it belongs _
  37. to a Button Manager Class then it will need a _
  38. reference.
  39.  
  40. 'Events
  41. Public Event Click() 'Click Event
  42. Public Event Press() 'Press Down Event
  43. Public Event UnPress() 'Release Event
  44. Public Event GetFocus() 'When the Button is given _
  45. "focus"
  46. Public Event LostFocus() 'The Opposite of GetFocus
  47.  
  48. 'Constant Declarations
  49. Const const_strDn As String = "Pressed"
  50. Const const_strUp As String = "Un-Pressed"
  51. Private Function InScope(X As Single, Y As Single)
  52. 'Checks the X and Y of the event that calls it, _
  53. VERY Simple Function
  54. InScope = ((X - Left) > 0 And (X - Left) < Width) And ((Y - Top) > 0 And (Y - Top) < Height)
  55. End Function
  56. Private Sub MouseProc(Button As Integer, X As Single, Y As Single)
  57. If Not CBool(Button - 1) Then
  58. If InScope(X, Y) And IClicked Then
  59. If LastState = const_strDn Then Exit Sub
  60. LastState = const_strDn
  61. Redraw
  62. On Error Resume Next
  63. ButtonParentObj.RaiseBtnEvent Me, const_lngPress
  64. On Error GoTo 0
  65. RaiseEvent Press
  66. Exit Sub
  67. Else
  68. If LastState = const_strUp Then Exit Sub
  69. LastState = const_strUp
  70. Redraw
  71. RaiseEvent UnPress
  72. Exit Sub
  73. End If
  74. End If
  75. End Sub
  76.  
  77. Public Sub MouseUp(Button As Integer, X As Single, Y As Single)
  78. If Not Enabled Then Exit Sub
  79. If InScope(X, Y) And Button = 1 And IClicked Then
  80. LastState = const_strUp
  81. Redraw
  82. DoEvents
  83. On Error Resume Next
  84. ButtonParentObj.RaiseBtnEvent Me, const_lngUnPress
  85. ButtonParentObj.RaiseBtnEvent Me, const_lngClick
  86. On Error GoTo 0
  87. RaiseEvent UnPress
  88. RaiseEvent Click
  89. End If
  90. IClicked = False
  91. End Sub
  92.  
  93. Public Sub MouseDown(Button As Integer, X As Single, Y As Single)
  94. If Not Enabled Then Exit Sub
  95. If Button = 1 Then
  96. If InScope(X, Y) Then
  97. IClicked = True
  98. End If
  99. End If
  100. MouseProc Button, X, Y
  101. End Sub
  102.  
  103. Public Sub MouseMove(Button As Integer, X As Single, Y As Single)
  104. If Not Enabled Then Exit Sub
  105. MouseProc Button, X, Y
  106. End Sub
  107.  
  108. Public Sub Redraw()
  109. Dim bFont As StdFont
  110. Dim m_lngFClr As OLE_COLOR
  111. Dim m_intDWid As Integer
  112. On Error Resume Next
  113. m_intDWid = Parent.DrawWidth
  114. Parent.DrawWidth = 1
  115. Left = (Left \ 15) * 15
  116. Top = (Top \ 15) * 15
  117. Width = (Width \ 15) * 15
  118. Height = (Height \ 15) * 15
  119. Parent.Line (Left, Top)-(Left + Width - 15, Top + Height - 15), BackColor, BF
  120. DrawImage
  121. m_lngFClr = Parent.ForeColor
  122. If Not Enabled Then
  123. Parent.ForeColor = vbGrayText
  124. Else
  125. Parent.ForeColor = ForeColor
  126. End If
  127. Set bFont = Parent.Font
  128. Set Parent.Font = Font
  129. Parent.CurrentX = Left + (Width / 2 - Parent.TextWidth(Caption) / 2) + -(CInt(CBool(LastState = const_strDn)) * (Screen.TwipsPerPixelX * 2))
  130. Parent.CurrentY = Top + (Height / 2 - Parent.TextHeight(Caption) / 2) + -(CInt(CBool(LastState = const_strDn)) * (Screen.TwipsPerPixelY * 2))
  131. Parent.Print Caption
  132. Set Parent.Font = bFont
  133. Parent.ForeColor = m_lngFClr
  134. If HasFocus Then
  135. DrawBox Parent, Left + 15, Top + 15, Width - 30, Height - 30, CBool(LastState = const_strDn), False, BackColor
  136. Parent.Line (Left, Top)-(Left + Width - 15, Top + Height - 15), vbBlack, B
  137. If Len(Caption) <> 0 Then
  138. DrawFocusRect Parent, Left + 75, Top + 75, Width - 150, Height - 150, 0
  139. End If
  140. Else
  141. DrawBox Parent, Left, Top, Width, Height, CBool(LastState = const_strDn), False, BackColor
  142. End If
  143. Parent.DrawWidth = m_intDWid
  144. DoEvents
  145. End Sub
  146.  
  147. Public Property Get Caption() As String
  148. Caption = rCaption
  149. End Property
  150.  
  151. Public Property Let Caption(ByVal vCaption As String)
  152. rCaption = vCaption
  153. Redraw
  154. End Property
  155.  
  156. Public Property Get HasFocus() As Boolean
  157. HasFocus = rHasFocus
  158. End Property
  159.  
  160. Public Property Let HasFocus(ByVal vHasFocus As Boolean)
  161. If rHasFocus = vHasFocus Then Exit Property
  162. rHasFocus = vHasFocus
  163. If rHasFocus Then
  164. On Error Resume Next
  165. ButtonParentObj.RaiseBtnEvent Me, const_lngGotFocus
  166. On Error GoTo 0
  167. RaiseEvent GetFocus
  168. ElseIf Not rHasFocus Then
  169. On Error Resume Next
  170. ButtonParentObj.RaiseBtnEvent Me, const_lngLostFocus
  171. On Error GoTo 0
  172. RaiseEvent LostFocus
  173. End If
  174. Redraw
  175. End Property
  176.  
  177. Private Sub Class_Initialize()
  178. PressKey = Key_Space
  179. LastState = const_strUp
  180. End Sub
  181.  
  182. Public Sub FocusChange(FocusButton As ComboPack.Button)
  183. Attribute FocusChange.VB_MemberFlags = "40"
  184. If FocusButton.Name = Name Then Exit Sub
  185. If Not HasFocus Then Exit Sub
  186. HasFocus = False
  187. Redraw
  188. End Sub
  189.  
  190. Private Sub DrawImage()
  191. Dim PictureWidth As Single
  192. Dim PictureLeft As Single
  193. Dim PictureLeft2 As Single
  194. Dim PictureHeight As Single
  195. Dim PictureTop As Single
  196. Dim PictureTop2 As Single
  197.     If Not Picture Is Nothing Then
  198.         If Not Picture = 0 Then
  199.             If Picture.Width / const_lngImageSize * 15 > Width Then
  200.                 PictureWidth = Width
  201.                 PictureLeft = Left
  202.                 PictureLeft2 = (Picture.Width / const_lngImageSize * 15) - Width
  203.             Else
  204.                 PictureWidth = Picture.Width / const_lngImageSize * 15
  205.                 PictureLeft = Left + Width / 2 - PictureWidth / 2
  206.                 PictureLeft2 = 0
  207.             End If
  208.             If Picture.Height / const_lngImageSize * 15 > Height Then
  209.                 PictureHeight = Height
  210.                 PictureTop = Top
  211.                 PictureTop2 = (Picture.Height / const_lngImageSize * 15) - Height
  212.             Else
  213.                 PictureHeight = Picture.Height / const_lngImageSize * 15
  214.                 PictureTop = Top + Height / 2 - PictureHeight / 2
  215.                 PictureTop2 = 0
  216.             End If
  217.             Parent.PaintPicture Picture, PictureLeft - (CBool(LastState = const_strDn) * 30), PictureTop - (CBool(LastState = const_strDn) * 30), PictureWidth, PictureHeight, PictureLeft2, PictureTop2
  218.         End If
  219.     End If
  220. End Sub
  221. Public Property Get Font() As StdFont
  222. Set Font = rFont
  223. End Property
  224. Public Property Set Font(ByVal vFont As StdFont)
  225. Set rFont = vFont
  226. Redraw
  227. End Property
  228.  
  229. Public Property Get Enabled() As Boolean
  230. Enabled = rEnabled
  231. End Property
  232.  
  233. Public Property Let Enabled(ByVal vEnabled As Boolean)
  234. rEnabled = vEnabled
  235. IClicked = False
  236. LastState = ""
  237. Redraw
  238. End Property
  239.  
  240. Public Property Get State() As String
  241. State = LastState
  242. End Property
  243.  
  244. Public Property Get Pressed() As Boolean
  245. Pressed = (State = const_strDn)
  246. End Property
  247.  
  248. Public Sub KeyDown(KeyCode As Integer)
  249.     If Not HasFocus Then Exit Sub
  250.     Select Case KeyCode
  251.         Case PressKey
  252.             RaiseEvent Press
  253.             If State = const_strDn Then Exit Sub
  254.             LastState = const_strDn
  255.             Redraw
  256.         Case vbKeyReturn
  257.             RaiseEvent Click
  258.     End Select
  259. End Sub
  260.  
  261. Public Sub KeyUp(KeyCode As Integer)
  262.     If Not HasFocus Then Exit Sub
  263.     Select Case KeyCode
  264.         Case PressKey
  265.             If Not State = const_strDn Then Exit Sub
  266.             LastState = const_strUp
  267.             Redraw
  268.             RaiseEvent Click
  269.     End Select
  270. End Sub
  271.